# -*-perl-*-
# $Id$
# Copyright (C) 2002-2005 Freescale Semiconductor, Inc.
# Distributed under terms of the Perl license, which is the disjunction of
# the GNU General Public License (GPL) and the Artistic License.

# Writer for html files

=pod
=begin reST
=begin Description
This writer creates HTML output.
It uses the following output defines:

-W attribution=<dash|parentheses|parens|none>
                       Specifies how the attribution of a block quote
                       is to be formatted (default is 'dash').
-W body-attr=<text>    Specifies attributes to be passed to the <body>
                       tag (default is '').
-W body-only[=<0|1>]   Only the contents of the HTML body tag are output.
                       Default is 0 unless specified with no value.
-W cloak-email-addresses[=<0|1>]
                       Enables cloaking of email addresses to keep
                       spambots from harvesting email addresses.
                       Default is 0.
-W colspecs[=<0|1>]    Output colgroup width sections in tables based upon 
                       the relative widths of the table columns in the 
                       source.  Default is 1.
-W embed-stylesheet[=<0|1>]
                       Embed the primary stylesheet verbatim in the
                       HTML output if possible.  Stylesheets with
                       http: URLs are not embeddable.  If prest is
                       installed with no default URL specified, the
                       default stylesheet is always embedded.  Default
                       is 0.
-W enum-list-prefixes[=<0|1>]
                       Specify whether to keep information on prefixes
                       and suffixes of enumerated lists in the output;
                       can be used to specify styles based upon the prefix
                       and suffix attributes.  Default is 0.
-W field-colon[=<0|1>]
                       Specify whether a field-name should be followed
                       by a colon.  Such a colon can be supplied by a
                       style sheet, but this option is retained for
                       backward compatibility.  Default is 1.
-W field-limit=<num>   Specify the maximum width (in characters) for
                       field names in field lists.  Longer fields will
                       span an entire row of the table used to render
                       the field list.  Default is 14 characters.
-W footnote-backlinks=<0|1>
                       Enable backlinks from footnotes and citations
                       to their references if 1 (default is 1).
-W footnote-references=<superscript|brackets>
                       Format for footnote references.  Default is
                       "superscript".
-W html-prolog=<0|1>
                       Generate file prolog for XHTML if 0 or
                       HTML if 1 (default is 0).
-W image-exts=<ext-list>
                       A comma-separated list of "ext1=ext2" pairs where 
                       any URI with extension ext1 has it mapped to ext2.
                       This option allows using a single document
                       source with multiple writers by using whatever
                       figure extension is appropriate for a given writer.
                       (Deprecated: use "-D image-exts=" instead.)
-W link-target=<expr>  An expression that determines what the target
                       frame will be in link references.  The
                       link URL is available in ``$_`` so that the
                       target frame can depend upon the URL
                       (default is "").
-W option-limit=<num>  Specify the maximum width (in characters) for
                       options in option lists.  Longer options will
                       span an entire row of the table used to render
                       the option list.  Default is 14 characters.
-W stylesheet[=<0|URL|file>]
                       Specify a URL or file for the primary stylesheet
                       in the HTML header, or 0 or 'none' to omit the
                       primary stylesheet.  A file or "file:" URL
                       should be either a full path or a path relative
                       to where the HTML file will be served.  The
                       stylesheet will be a link unless 
                       -W embed-stylesheet is specified and the
                       stylesheet is embeddable.  Defaults to
                       "${Text::Restructured::PrestConfig::DEFAULTCSS}"
-W stylesheet2=file
		       Specify a file to be embedded in the HTML
                       header as a secondary stylesheet.
-W target-tag=<a|span>
                       The HTML tag to use for target definitions (default 
                       is "a").
=end Description
=end reST
=cut

sub BEGIN = {
    # My -W flags
    use vars qw($attribution $body_attr $body_only
		$cloak_email_addresses $colspecs $embed_stylesheet
		$enum_list_prefixes $field_colon $field_limit
		$footnote_backlinks $footnote_references $html_prolog
		$image_exts $link_target $option_limit $stylesheet
		$stylesheet2 $target_tag);

    # Static globals
    use vars qw($DOM);
    *DOM = \'Text::Restructured::DOM'; #';

    # Run-time globals
    use vars qw($HAS_CONTENTS $TARGET_FRAME $FOOTER $HEADER @HEAD @HEAD_INFO
		%IMAGE_EXTS $IMAGE_EXT_RE %USED_DEFAULT $DOCTYPE $DOCDOM);

    # Defaults for -W flags
    $attribution = 'dash' unless defined $attribution;
    $body_attr = '' unless defined $body_attr;
    $cloak_email_addresses = '' unless defined $cloak_email_addresses;
    $colspecs = 1 unless defined $colspecs;
    # Note: $stylesheet will be 'none' only if DEFAULTCSS is
    $stylesheet = '' unless defined $stylesheet;
    $stylesheet = $stylesheet =~ /^(0|none)$/i ? 0 :
	$stylesheet ? $stylesheet :
	$Text::Restructured::PrestConfig::DEFAULTCSS;
    my $embeddable = $stylesheet && $stylesheet !~ /^http:/;
    $embed_stylesheet =	$stylesheet =~ /^none$/ ||
	$embed_stylesheet && $embeddable;
    $field_colon = 1 unless defined $field_colon;
    $field_limit = 14 unless defined $field_limit;
    $footnote_backlinks = 1 unless defined $footnote_backlinks;
    $footnote_references = 'superscript'
	unless defined $footnote_references;
    $html_prolog = 0 unless defined $html_prolog;
    $link_target = "''" unless defined $link_target;
    $option_limit = 14 unless defined $option_limit;
    $target_tag = "a" unless defined $target_tag;
    $image_exts = '' unless defined $image_exts;

    %IMAGE_EXTS = split /[,=]/, $image_exts;
    $IMAGE_EXT_RE = join '|', map("\Q$_", keys %IMAGE_EXTS);
    $DOCTYPE = $html_prolog ? << "EOPROLOG1" : << "EOPROLOG2" ;
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
EOPROLOG1
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
EOPROLOG2
    ;
}

# Creates a default HTML string
sub Default {
    my ($dom, $str) = @_;
    my $attr = GetAttr($dom);
    my $tag = $dom->tag;
    if (($dom->{attr}{'xml:space'} || '') eq 'preserve') {
	$str = qq(<pre class="$tag">$str</pre>\n\n);
    }
    my $newstr = "<$tag$attr>$str</$tag>";
    # Annotate the DOM with our content string
    $dom->{_html}{str} = $str;
    return $newstr;
}

# Creates a string from a reference to an attribute hash.  Attribute
# values may be either scalars or array references.
# Arguments: hash reference
# Returns: string
sub MakeAttrList {
    my ($attr) = @_;
    return '' unless defined $attr && %$attr;
    # Quote "
    grep ref($attr->{$_}) eq 'ARRAY' ?
	grep(s/\"/&quot;/g, @{$attr->{$_}}) :
	defined $attr->{$_} && $attr->{$_} =~ s/\"/&quot;/g, keys %$attr;
    # Force ids to be unique
    my $id  = $attr->{id};
    if ($id && $DOCDOM->{_html}{ids}{$id}++) {
	
	my $ids_hr = $DOCDOM->{_html}{ids};
	my $sfx;
	for ($sfx = '0001'; $ids_hr->{"$id-$sfx"}; $sfx++) {
	}
	my $new_id         = "$id-$sfx";
	$attr->{id}        = $new_id;
	$ids_hr->{$new_id} = 1;
    }
    return ' ' . join(' ', map($_ . (! defined $attr->{$_} ? '' :
				     ref($attr->{$_}) eq 'ARRAY' ?
				     qq(="@{$attr->{$_}}") :
				     qq(="$attr->{$_}")),
			       sort keys %$attr));
}

# Returns the attribute string for a DOM based upon its attr and _html,attr
# elements.
# Arguments: DOM object
# Returns: string
sub GetAttr {
    my ($dom) = @_;

    # The only thing taken from attr is {classes}, which is translated to
    # 'class' under {_html}.
    $dom->{_html}{attr}{class} = $dom->{attr}{classes}
        if $dom->{attr}{classes} && @{$dom->{attr}{classes}};
    my $attr_list = $dom->{_html}{attr} ?
	MakeAttrList(\%{$dom->{_html}{attr}}) : '';
    delete $dom->{_html}{attr}{class};
    return $attr_list;
}

# Returns all the "paragraphs" from the DOM's contents (everything except
# comments, targets, substitution_definitions
# Arguments: DOM object
# Returns: list of DOM objects
sub Paras {
    my ($dom) = @_;

    grep($_->tag !~ /^(comment|target|substitution_definition)$/,
	 $dom->contents);
}

# Encodes HTML-specific characters
# Arguments: string
# Returns: substituted string
sub EncodeHTML {
    my ($s) = @_;
    $s =~ s/&/&amp;/g;
    $s =~ s/</&lt;/g;
    $s =~ s/>/&gt;/g;
    # uncoverable statement count:2 note:Must be Devel::Cover bug
    # uncoverable statement count:3 note:Must be Devel::Cover bug
    # uncoverable statement count:4 note:Must be Devel::Cover bug
    $s =~ s/[\xa0\xc2]/&nbsp;/g;
#    $s =~ s/\"/&quot;/g;   ######## FIX
    $s =~ s/\@/&\#64;/g;   ######## FIX
    return $s;
}

# Removes markup that interferes with title display
# Arguments: string
# Returns: sanitized string
sub SanitizeTitle {
    my ($s) = @_;
    chomp $s;
    $s =~ s!</?\w.*?>!!g;
    return $s;
}

# This phase fixes all the attribute values to have characters that are
# safe for HTML files
phase FIXATTR {
    sub .* = { # FIXATTR
	my ($dom, $str) = @_;
	my $attr;
	foreach $attr (keys %{$dom->{attr}}) {
	    # uncoverable branch false count:2 note:guards against bug
	    if (ref($dom->{attr}{$attr}) eq 'ARRAY') {
		@{$dom->{attr}{$attr}} =
		    map(EncodeHTML($_), @{$dom->{attr}{$attr}});
	    }
	    elsif (defined $dom->{attr}{$attr}) {
		$dom->{attr}{$attr} =
		    EncodeHTML($dom->{attr}{$attr});
	    }
	}
	$DOCDOM = $dom if $dom->tag eq 'document';
	return;
    }
}

# This phase preprocesses the file.
phase PREPROCESS {

    sub \#PCDATA = { # PREPROCESS
	my ($dom) = @_;
	my $parent = $dom->parent;
        return $parent->tag eq 'raw' ? $dom->{text} :
	    EncodeHTML($dom->{text});
    }

    sub document = { # PREPROCESS
	my ($dom) = @_;
	my $nesting = 0;
	# Compute the nesting levels for titles
	$dom->Recurse
	    (sub {
		my ($dom, $when) = @_;
		if ($dom->tag eq 'section') {
		    $nesting += $when eq 'pre' ? 1 : -1;
		}
		elsif ($dom->tag eq 'title') {
		    $dom->{_html}{nesting} = $nesting;
		}
		return 0;
	    }, 'both');

	my $target_frame = "sub { (\$_)=\@_; $link_target}";
	$TARGET_FRAME = eval($target_frame);
	die "Cannot parse link target $link_target: $@" if $@;
	return;
    }

    sub docinfo = { # PREPROCESS
	my ($dom, $str) = @_;

	# Flatten Authors if it exists
	$dom->Reshape(sub {
	    my ($dom) = @_;
	    return $dom->contents if ($dom->tag eq 'authors');
	    return $dom;
	});
	
	return;
    }

    sub author|date|organization|copyright = { # PREPROCESS
	my ($dom, $str) = @_;
	chomp $str;
	my $headstr = $str;
	$headstr =~ s/\n/ /g;
	# Remove any HTML tags within it
	$headstr =~ s/<[^>]*>//g;
	push (@HEAD_INFO, [$dom->tag, $headstr]);
	return $str;
    }

    sub meta = { # PREPROCESS
	my ($dom) = @_;
	my $attr = MakeAttrList($dom->{attr});
	push (@HEAD_INFO, "<meta$attr />\n");
	return;
    }

    sub reference = { # PREPROCESS
	my ($dom, $str) = @_;
	chomp $str;
	#### FIX 
	use vars qw($FIRST_REFERENCE);
	push (@{$dom->{attr}{classes}},  'first', 'last')
	    if ! $FIRST_REFERENCE++;
	return;
    }

    sub authors = { # PREPROCESS
	return;
    }

    sub literal = { # PREPROCESS
	my ($dom, $str) = @_;
	PreprocessLiteral($dom);
	return;

	sub PreprocessLiteral {
	    my ($dom) = @_;
	    my $child;
	    foreach $child ($dom->contents) {
		if ($child->tag eq '#PCDATA') {
		    my $str = $child->{val};
		    $str =~ s|(\s+)|</span>$1<span class="pre">|g;
		    $str =~ s/( +) /("&nbsp;" x length($1)) . " "/ge;
		    $child->{val} = qq(<span class="pre">$str</span>);
		}
		elsif ($child->tag eq 'literal') {
		    $child->{_html}{txt} = $child->{lit};
		}
		else {
		    PreprocessLiteral($child);
		}
	    }
	}
    }

    sub (?:doctest|literal)_block = { # PREPROCESS
	my ($dom, $str) = @_;
	# Go through the children recursively
	my $s = TraverseLiteral($dom);
	# Get rid of my children
	$dom->replace;
	
	return $s;
        sub TraverseLiteral {
	    my ($dom) = @_;
	    my $str;
	    my $child;
	    foreach $child ($dom->contents) {
		$str .= EncodeHTML($child->{text});
	    }
	    return $str;
	}
    }

    sub list_item = { # PREPROCESS
	my ($dom, $str) = @_;

	# Compute whether we're simple or not
	my @children = Paras($dom);
	pop @children if @children && $children[0]->tag eq 'paragraph' &&
	    $children[-1]->tag =~ /_list$/ && $children[-1]{_html}{simple};
	$dom->{_html}{simple} = (@children < 2);
	return Default($dom, $str);
    }

    sub definition|field_body|description|entry = { # PREPROCESS
	my ($dom, $str) = @_;
	my @paras = Paras($dom);
	if (@paras > 1) {
	    push @{$paras[0]{attr}{classes}}, 'first';
	    push @{$paras[-1]{attr}{classes}}, 'last';
	}
	return Default($dom, $str);
    }

    sub (?:bullet|enumerated)_list = { # PREPROCESS
	my ($dom, $str) = @_;
	my $parent = $dom->parent;

	# I'm simple if all my list_item children are simple.
	$dom->{_html}{simple} = 1;
	my $li;
	foreach $li ($dom->contents) {
	    if (! $li->{_html}{simple}) {
		$dom->{_html}{simple} = 0;
		last;
	    }
	}

	# IF I'm not simple, neither are my list_item children
	if (! $dom->{_html}{simple}) {
 	    foreach $li ($dom->contents) {
 		$li->{_html}{simple} = 0;
		push @{$li->first->{attr}{classes}},'first';
	    }
	}
	return Default($dom, $str);
    }

    sub attention|caution|danger|error|hint|important|note|tip|warning = { # PREPROCESS
	my ($dom, $str) = @_;
	# Need to turn our title into a paragraph
	use vars qw(%ADM_TITLES);
	BEGIN {
	    %ADM_TITLES = ('Danger'=>'!DANGER!', 'Caution'=>'Caution!',
			   'Attention'=>'Attention!');
	}
	my $tag = ucfirst $dom->tag;
	my $label = $ADM_TITLES{$tag} || $tag;
	my $para = $DOM->new('paragraph',
			     classes=>[qw(first admonition-title)]);
	$para->append($DOM->newPCDATA($label));
	$dom->prepend($para);
	push @{$dom->last->{attr}{classes}}, 'last';
	return;
    }

    sub admonition = { # PREPROCESS
	my ($dom, $str) = @_;

	push @{$dom->{attr}{classes}}, 'admonition';
	my @paras = Paras($dom);
	# Need to turn our title into a paragraph and myself into a div
	my $para = $DOM->new('paragraph',
			   classes=>[qw(first admonition-title)]);
	$para->append($dom->first->contents);
	$dom->splice(0, 1, $para);
	push @{$paras[-1]{attr}{classes}}, 'last';
	$dom->tag('div');
    }

    sub footnote|citation = { # PREPROCESS
	my ($dom, $str) = @_;
	# Get the label out of our first child's child
	# uncoverable branch false note:First child is always label
	if ($dom->first->tag eq 'label') {
	    my $label = $dom->first->{_html}{str};
	    chomp $label;
	    $dom->{_html}{label} = $label;
	    # Delete the label that is our first child
	    $dom->splice(0, 1);
	}
	# Label the first/last paragraph if needed
	my @paragraphs = Paras($dom);
	push @{$paragraphs[0]{attr}{classes}}, 'first'
	    if @paragraphs > 1;
	push @{$paragraphs[-1]{attr}{classes}}, 'last'
	    if @paragraphs > 1;
    }

    sub footnote_reference = { # PREPROCESS
	my ($dom, $str) = @_;

	# Need to trim a preceding space if using superscript
	if ($footnote_references eq 'superscript') {
	    my $parent = $dom->parent;
	    my $index = $parent->index($dom);
	    $parent->child($index-1)->{val} =~ s/ +$//
		if $index > 0 &&
		$parent->child($index-1)->tag eq '#PCDATA';
	}
    }

    sub definition_list_item = { # PREPROCESS
	my ($dom, $str) = @_;
	# Need to restructure the classifiers under the term
	my @classifiers = grep($_->tag eq 'classifier', $dom->contents);
	if (@classifiers) {
	    $dom->splice(1, 0+@classifiers);
	    $dom->first->append(@classifiers);
	}
	return;
    }

    sub table = { # PREPROCESS
	my ($dom, $str) = @_;
	# Turn a title into a caption
	$dom->first->tag('caption')
	    if $dom->first->tag eq 'title';
    }

    sub colspec = { # PREPROCESS
	my ($dom, $str) = @_;
	# Add the "stub" class to all the entries of my column if I'm stub
	if ($dom->{attr}{stub}) {
	    my $parent = $dom->parent;
	    my $indx = $parent->index($dom);
	    foreach my $cont ($parent->contents) {
		next if $cont->tag eq 'colspec';
		foreach my $row ($cont->contents) {
		    push @{$row->child($indx)->{attr}{classes}}, 'stub';
		}
		
	    }
	}
	return;
    }

    sub thead = { # PREPROCESS
	my ($dom, $str) = @_;
	# Add the "head" class to each entry of each row
	foreach my $row ($dom->contents) {
	    foreach my $entry ($row->contents) {
		unshift @{$entry->{attr}{classes}}, 'head';
	    }
	}
	return;
    }

    sub image = { # PREPROCESS
	my ($dom, $str, $writer) = @_;
	# Insert a <div> object in the DOM above me if my parent takes
	# body elements.
	my $ancest = $writer->Ancestors;
	my $parent = $ancest->[-1];
#	my $parent = $dom->parent;
	return unless $parent->takes_body_elts;
	my $indx = $parent->index($dom);
	my @classes = ('image');
	push @classes, @{$dom->{attr}{classes}} if $dom->{attr}{classes};
	my $div = $DOM->new('div', classes=>\@classes);
	$div->append($parent->child($indx));
	$parent->splice($indx, 1, $div);
    }

    sub generated = { # PREPROCESS
	my ($dom, $str) = @_;
	return $str;
    }

    sub sidebar = { # PREPROCESS
	my ($dom, $str) = @_;

	my @paras = Paras($dom);
	# Turn any title or subtitle into paragraphs
	foreach my $child ($dom->contents) {
	    if ($child->tag eq 'title') {
		$child->tag('paragraph');
		push @{$child->{attr}{classes}}, qw(first sidebar-title);
	    }
	    elsif ($child->tag eq 'subtitle') {
		$child->tag('paragraph');
		push @{$child->{attr}{classes}}, 'sidebar-subtitle';
	    }
	    else {
		last;
	    }
	}
	push @{$paras[-1]{attr}{classes}}, 'last';
	# Turn myself into a div
	$dom->tag('div');
	push @{$dom->{attr}{classes}}, 'sidebar';

	return;
    }

    sub rubric = { # PREPROCESS
	my ($dom, $str) = @_;
	# Turn myself into a paragraph
	$dom->tag('paragraph');
	$dom->{attr}{classes} = [ 'rubric' ];
	return;
    }

    sub compound = { # PREPROCESS
	my ($dom, $str) = @_;
	my @paras = Paras($dom);
	# uncoverable branch false count:2 note:Compound must have content
	if (@paras > 1) {
	    foreach (my $i=0; $i < @paras; $i++) {
		my $c = $i == 0 ? 'compound-first' :
		    $i == $#paras ? 'compound-last' : 'compound-middle';
		unshift @{$paras[$i]{attr}{classes}}, $c;
	    }
	}
	elsif (@paras) {
	    unshift @{$paras[0]{attr}{classes}},
	    'compound-first', 'compound-last';
	}
	# Turn myself into a div
	$dom->tag('div');
	push @{$dom->{attr}{classes}}, 'compound';
	return;
    }

    sub mathml = { # PREPROCESS
	my ($dom, $str) = @_;
	return $str unless $dom->{attr}{mathml};
	$DOCTYPE = << "EOS";
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0//EN" 
               "http://www.w3.org/TR/MathML2/dtd/xhtml-math11-f.dtd" [
  <!ENTITY mathml "http://www.w3.org/1998/Math/MathML">
]>
EOS
	;
	use HTML::Entities;
	my $text = $dom->{attr}{mathml}->text;
	# Fix up the HTML entities to be nicer
	$text =~ s/(&\#x([\da-fA-F]+);)/
	    # uncoverable branch true note:There should always be an entity
	    $HTML::Entities::char2entity{chr(hex($2))} || $1/ge;
	if (my $label = $dom->{attr}{label}) {
	    return qq(<table class="mathml" rules="none"><col width="100%"/><col width="0*"/><tr><td>$text</td><td align="right">($label)</td></tr></table>\n)
	}
	return $text;
    }


    sub .* = { # PREPROCESS
	my ($dom, $str) = @_;
	$USED_DEFAULT{$dom->tag} = 1;
	return Default($dom, $str);
    }
}

# This phase produces the final output
phase PROCESS {

    sub paragraph = { # PROCESS
	my ($dom, $str) = @_;

	my $parent = $dom->parent;
	my $p_tag = $parent->tag;
	my $index = $parent->index($dom);
	my @paras = Paras($parent);
	chomp $str;
	return "$str"
	    if (! $dom->{attr}{classes} && 
		(($p_tag eq 'list_item' && $parent->{_html}{simple}) ||
		 (@paras == 1 && $p_tag !~ /list_item|block_quote|topic/)));

	$dom->{_html}{attr}{id} = shift @{$dom->{attr}{ids}}
	    if $dom->{attr}{ids};
	my @ids = @{$dom->{attr}{ids}} if $dom->{attr}{ids};
	my $spans = join '', map(qq(<$target_tag id="$_"></$target_tag>),
				 @ids);
	my $attr = GetAttr($dom);
	return  "$spans<p$attr>$str</p>\n";
    }

    sub \#PCDATA = { # PROCESS
	my ($dom, $str) = @_;
	return defined $dom->{val} ? $dom->{val} :
	    EncodeHTML($dom->{text});
    }

    sub (?:doctest|literal)_block = { # PROCESS
	my ($dom, $str) = @_;
	my @class = $dom->{attr}{classes} ? @{$dom->{attr}{classes}} : ();
	my $class = $dom->tag;
	$class =~ s/_/-/;
	push(@class, $class);
	my $attr = qq( class=") . join(' ',@class) . qq(");
	return qq(<pre$attr>$dom->{val}</pre>\n);
    }

    sub attention|caution|danger|error|hint|important|note|tip|warning = { # PROCESS
	my ($dom, $str) = @_;
	my $tag = $dom->tag;
	return qq(<div class="$tag">\n$str</div>\n);
    }

    # These just need to return their string
    sub definition_list_item = { # PROCESS
 	my ($dom, $str) = @_;
 	return $str;
    }

    sub title = { # PROCESS
	my ($dom, $str) = @_;

	my $parent = $dom->parent;
	my $p_tag = $parent->tag || '';
	my $tag;
	my $tag_attr = '';
	my %a_attr;
	# Figure out how deeply I'm nested
	my $nesting = $dom->{_html}{nesting};
	if ($p_tag =~ /^(topic|sidebar)$/) {
	    $a_attr{name} = $parent->{attr}{ids}[0]
	    if $parent->{attr}{classes} &&
	    $parent->{attr}{classes}[0] eq 'contents';
	    $tag = "p";
	    $dom->tag('paragraph');
	    $tag_attr = qq( class="$p_tag-title first");
	}
	elsif ($parent->{attr}{classes}[0] || '' eq 'system-messages') {
	    $tag = "h$nesting";
	}
	else {
	    $a_attr{class} = "toc-backref" if $HAS_CONTENTS;
	    $a_attr{href} = "#$dom->{attr}{refid}"
		if defined $dom->{attr}{refid};
	    $a_attr{name} = $parent->{attr}{ids}[0];
	    $tag = "h$nesting";
	}
	my $a_attr = MakeAttrList(\%a_attr);
	chomp $str;
	$str = "<a$a_attr>$str</a>" unless $tag eq 'p' && $a_attr eq '';
	return qq(<$tag$tag_attr>$str</$tag>\n);
    }

    sub (?:bullet|enumerated|definition)_list = { # PROCESS
	my ($dom, $str) = @_;
	# Figure out if I'm the least nested list
	use vars qw(%LIST_TAGS);
	BEGIN { %LIST_TAGS = ('bullet_list'=>'ul', 'enumerated_list'=>'ol',
			      'definition_list'=>'dl'); }
	my $tag = $LIST_TAGS{$dom->tag};
	my $attr = $dom->{attr};
	$dom->{attr}{classes} ||= [];
	my $class = $dom->{attr}{classes};
	push @$class, $attr->{enumtype} if $tag eq 'ol';
	push @$class, 'docutils' if $tag eq 'dl';
	push @$class, 'simple' if $dom->{_html}{simple};
	$dom->{_html}{attr}{start} = $attr->{start} if defined $attr->{start};
	if ($enum_list_prefixes) {
	    $dom->{_html}{attr}{prefix} = $attr->{prefix}
	    if $attr->{prefix};
	    # uncoverable branch false note:Suffix required for enum list
	    $dom->{_html}{attr}{suffix} = $attr->{suffix}
	    if $attr->{suffix};
	}
	my $attrlist = GetAttr($dom);
	return (qq(<$tag$attrlist>\n$str</$tag>\n));
    }

    sub list_item = { # PROCESS
	my ($dom, $str) = @_;
 	my $attr = $dom->{attr};
	my $attrlist = GetAttr($dom);
	return qq(<li$attrlist>$str</li>\n);
    }

    sub section = { # PROCESS
	my ($dom, $str) = @_;
	
 	my $attr = $dom->{attr};
	my $hattr = $dom->{_html}{attr} = {};
	$hattr->{id} = $attr->{ids}[0] if $attr->{ids};
	push @{$attr->{classes}}, 'section';
	my @ids = @{$attr->{ids}} if $attr->{ids};
	shift @ids;
	my $spans = join '', map(qq(<$target_tag id="$_"></$target_tag>),
				 @ids);
	my $attrlist = GetAttr($dom);
	return qq($spans<div$attrlist>\n$str</div>\n);
    }

    # All of these items need to chomp a preceding #PCDATA
    sub emphasis|strong|subscript|superscript = { # PROCESS
	my ($dom, $str) = @_;
	use vars qw(%TAG_TRANSLATE);
	BEGIN {
	    %TAG_TRANSLATE = qw(emphasis em subscript sub superscript sup);
	}
	$dom->tag(defined $TAG_TRANSLATE{$dom->tag} ?
		  $TAG_TRANSLATE{$dom->tag} : $dom->tag);
	chomp $str;
	return Default($dom, $str);
    }

    sub target = { # PROCESS
	my ($dom, $str) = @_;
	chomp $str;
	my $id = $dom->{attr}{ids} ? $dom->{attr}{ids}[0] : '';
	my $class = $str ne '' ? qq( class="target") : '';
	return (! defined $dom->{attr}{refuri} &&
		! defined $dom->{attr}{refid} &&
		defined $dom->{attr}{ids}) || $str ne '' ?
	    qq(<$target_tag$class id="$id">$str</$target_tag>) :
	    "";
    }

    sub problematic = { # PROCESS
	my ($dom, $str) = @_;
	my $attr = $dom->{attr};
	return qq(<a href="#$attr->{refid}" name="$attr->{ids}[0]"><span class="problematic" id="$attr->{ids}[0]">$str</span></a>);
    }

    sub footnote_reference = { # PROCESS
	my ($dom, $str) = @_;

	my $parent = $dom->parent;
	my %attr;
	$attr{class} = "footnote-reference";
	# uncoverable branch false note:Assert refid filled in
	my $ref = $attr{href} = "#$dom->{attr}{refid}" if $dom->{attr}{refid};
	$attr{name} = $attr{id} = $dom->{attr}{ids}[0];
	my $target = &$TARGET_FRAME($ref);
	$attr{target} = $target if $target ne '';
	my $attr = MakeAttrList(\%attr);
	chomp $str;
	my $index = $parent->index($dom);
	my $ref_str = $footnote_references eq 'superscript' ?
	    "<sup>$str</sup>" : "[$str]";
	return qq(<a$attr>$ref_str</a>);
    }

    sub literal = { # PROCESS
	my ($dom, $str) = @_;
	my %attr;
	$attr{class} = [qw(docutils literal)];
	push @{$attr{class}}, @{$dom->{attr}{classes}}
	    if $dom->{attr}{classes};
	my $attr = MakeAttrList(\%attr);
	return defined $dom->{_html}{txt} ? $dom->{_html}{txt} :
	    qq(<tt$attr>$str</tt>);
    }

    sub term = { # PROCESS
	my ($dom, $str) = @_;

	chomp $str;
	return qq(<dt>$str</dt>\n);
    }

    sub classifier = { # PROCESS
	my ($dom, $str) = @_;
	chomp $str;
	return qq( <span class="classifier-delimiter">:</span> <span class="classifier">$str</span>);
    }

    sub definition = { # PROCESS
	my ($dom, $str) = @_;
	return qq(<dd>$str</dd>\n);
    }

    sub reference = { # PROCESS
	my ($dom, $str) = @_;
	chomp $str;

	my $ref = defined $dom->{attr}{refuri} ?
	    $dom->{attr}{refuri} : defined $dom->{attr}{refid} ?
	    "#$dom->{attr}{refid}" : undef;
	my @class = $dom->{attr}{classes} ?
	    @{$dom->{attr}{classes}} : ();
	push(@class, $dom->tag);
	my $class = join(' ',@class);
	my %attr = ('class'=>"$class");
	if ($cloak_email_addresses && $ref =~ /^mailto:/) {
	    # Put back any &whatever; codes
	    $ref =~ s/&\#(\d+);/chr($1)/ge;
	    $str =~ s/&\#(\d+);/chr($1)/ge;
	    $ref =~ /^mailto:(.*)/;
	    $ref = 'mailto:' . join('', map(sprintf('%%%02X', ord($_)),
					    split(//, $1)));
	    $str =~ s!([@\.])!<span>\&\#${\ord($1)};</span>!g;
	}
	$attr{href} = $ref if defined $ref;
	$attr{id} = $dom->{attr}{ids}[0] if $dom->{attr}{ids};
	$attr{name} = $dom->{attr}{ids}[0] if $dom->{attr}{ids};
	my $target = defined $ref ? &$TARGET_FRAME($ref) : '';
	$attr{target} = $target if $target ne '';
	my $attr = MakeAttrList(\%attr);
	my $s = "<a$attr>$str</a>";
	$dom->{_html}{str} = $str;
	return $s;
    }

    sub footnote|citation = { # PROCESS
	my ($dom, $str) = @_;
	my (@list1, @list2);
	my @class = $dom->{attr}{classes} ?
	    @{$dom->{attr}{classes}} : ();
	push @class, 'docutils';
	push @class, $dom->tag;
	my $class = qq(class=") . join(' ',@class) . qq(");
	push(@list1, qq(<table $class frame="void" id="$dom->{attr}{ids}[0]" rules="none">\n));
	unshift(@list2, qq(</table>\n));
	push(@list1, qq(<colgroup><col class="label" /><col /></colgroup>\n));
	push(@list1, qq(<tbody valign="top">\n));
	unshift(@list2, qq(</tbody>\n));
	# uncoverable branch false note:html/label is always defined
	my $label = defined $dom->{_html}{label} ? $dom->{_html}{label} :
	    $dom->{attr}{name};
	my $backlinks;
	my @backrefs = @{$dom->{attr}{backrefs}} if $dom->{attr}{backrefs};
	if ($footnote_backlinks && @backrefs) {
	    if (@backrefs > 1) {
		$backlinks = '<em>(' . join(', ',map(qq(<a class="fn-backref" href="#$backrefs[$_-1]">$_</a>), 1 .. @backrefs)) . ')</em> ';
		push(@list1, qq(<tr><td class="label"><a name="$dom->{attr}{ids}[0]">[$label]</a></td><td>$backlinks$str</td></tr>\n));
	    }
	    else {
		push(@list1, qq(<tr><td class="label"><a class="fn-backref" href="#$dom->{attr}{backrefs}[0]" name="$dom->{attr}{ids}[0]">[$label]</a></td><td>$str</td></tr>\n));
	    }
	}
	else {
	    push(@list1, qq(<tr><td class="label"><a name="$dom->{attr}{ids}[0]">[$label]</a></td><td>$str</td></tr>\n));
	}
	return join '', @list1, @list2;
    }

    sub block_quote = { # PROCESS
	my ($dom, $str) = @_;
	my $attr = GetAttr($dom);
	return qq(<blockquote$attr>\n$str</blockquote>\n);
    }

    sub attribution = { # PROCESS
	my ($dom, $str) = @_;
	return '' if $attribution eq 'none';
	chomp $str;
	my $att = $attribution eq 'dash' ? "&mdash;$str" : "($str)";
	return qq(<p class="attribution">$att</p>\n);
    }

    sub comment = { # PROCESS
	my ($dom, $str) = @_;
	# uncoverable branch false note:All children are #PCDATA
	my $text = join('',map($_->tag eq '#PCDATA' ? $_->{text} : "",
			       $dom->contents));
	chomp $text;
	$text =~ s/--/- -/g;
	return qq(<!-- $text -->\n);
    }

    sub topic = { # PROCESS
	my ($dom, $str) = @_;
	my $hattr = $dom->{_html}{attr} = {};
	my $class = $dom->{attr}{classes} ? $dom->{attr}{classes}[0] : '';
	if ($class eq 'contents') {
	    $HAS_CONTENTS = 1;
	    $hattr->{id} = $dom->{attr}{ids}[0];
	}
	my %attr;
	push @{$dom->{attr}{classes}}, 'topic';
	my $attrlist = GetAttr($dom);
	return qq(<div$attrlist>\n$str</div>\n);
    }

    sub field_list = { # PROCESS
	my ($dom, $str) = @_;
	my (@list1, @list2);
	push @{$dom->{attr}{classes}}, qw(docutils field-list);
	$dom->{_html}{attr} = { qw(frame void   rules none) };
	my $attrlist = GetAttr($dom);
	push(@list1,
	     qq(<table$attrlist>\n),
	     qq(<col class="field-name" />\n),
	     qq(<col class="field-body" />\n),
	     qq(<tbody valign="top">\n)
	     );
	
	unshift(@list2, qq(</table>\n));
	unshift(@list2, qq(</tbody>\n));
	return join '', @list1, $str, @list2;
    }

    sub field_(?:name|argument|body) = { # PROCESS
	my ($dom, $str) = @_;
	chomp $str;
	return $str;
    }

    sub field = { # PROCESS
	my ($dom, $str) = @_;
	my %fields = map(($_->tag, $_->{val}), $dom->contents);
	my @str;
	my $fieldname = $fields{field_name};
 	# Back-convert HTML codes to figure out how long fieldargs is
 	(my $fieldchars = $fieldname) =~ s/&.*;/ /g;
	my $colspan = length($fieldchars) > $field_limit ?
	    qq( colspan="2") : '';
	my $tr = $colspan ? "</tr>\n" : '';
	my $cr = $fields{field_body} =~ m|</p>$| ? "\n" : '';
	my $colon = $field_colon ? ':' : '';
	push(@str,
	     qq(<tr class="field"><th class="field-name"$colspan>$fieldname$colon</th>$tr));
	push(@str, $colspan ?
	     qq(<tr><td>&nbsp;</td><td class="field-body">$fields{field_body}$cr</td>\n)
	     : qq(<td class="field-body">$fields{field_body}$cr</td>\n)
	     );
	push(@str, qq(</tr>\n));
	return join '',@str;
    }

    sub transition = { # PROCESS
	return qq(<hr class="docutils" />\n);
    }

    sub option_list = { # PROCESS
	my ($dom, $str) = @_;
	return << "EOS" ;
<table class="docutils option-list" frame="void" rules="none">
<col class="option" />
<col class="description" />
<tbody valign="top">
$str</tbody>
</table>
EOS
    }

    sub option_list_item = { # PROCESS
	my ($dom, $str) = @_;
	return qq(<tr>$str</tr>\n);
    }

    sub option_group = { # PROCESS
	my ($dom, $str) = @_;

	my $parent = $dom->parent;
	my $val = join(', ', map($_->{val}, $dom->contents));
	# Figure out what the raw text is
	my $raw = $val;
	$raw =~ s/<[^>]*>//g;
	my $cspan = '';
	if (length($raw) > $option_limit) {
	    $cspan = qq( colspan="2");
	    $parent->{_html}{colspan} = 2;
	}
	return qq(<td class="option-group"$cspan>\n<kbd>$val</kbd></td>\n);
    }

    sub option_string = { # PROCESS
	my ($dom, $str) = @_;
	return qq($str);
    }

    sub option = { # PROCESS
	my ($dom, $str) = @_;
	return qq(<span class="option">$str</span>);
    }

    sub option_argument = { # PROCESS
	my ($dom, $str) = @_;
	return qq($dom->{attr}{delimiter}<var>$str</var>);
    }

    sub description = { # PROCESS
	my ($dom, $str) = @_;

	my $parent = $dom->parent;
	my $append = ($parent->{_html}{colspan} || 0) == 2 ?
	    qq(</tr>\n<tr><td>&nbsp;</td>) : '';
	return qq($append<td>$str</td>);
    }

    sub table = { # PROCESS
	my ($dom, $str) = @_;
	my $tattr = $dom->{table_attr} || '';
	%{$dom->{_html}{attr}} = ($tattr =~ /(\w+)(?:=(\S+))?/g,
				  $tattr =~ /(\w+)="(.*?)"/g);
	$dom->{_html}{attr}{align} = $dom->{attr}{align}
	    if $dom->{attr}{align};
	if ($dom->{_html}{attr}{class}) {
	    push @{$dom->{attr}{classes}}, $dom->{_html}{attr}{class};
	    delete $dom->{_html}{attr}{class};
	}
	my $attr = GetAttr($dom);
	return qq(<table$attr>\n$str</table>\n);
    }

    sub tgroup = { # PROCESS
	my ($dom, $str) = @_;
	my $cols = $dom->{attr}{cols};
	my $rest = join('', map($dom->child($_)->{val},
				$cols .. ($dom->num_contents-1)));
	return $rest unless $colspecs;
	my @colwidths = map($dom->child($_)->{attr}{colwidth},
			    0 .. $cols-1);
	my $total = 0;
	grep($total += $_, @colwidths);
	my $colspecs = join('',map(sprintf(qq(<col width="%s%%" />\n),
					   int(100*$_/$total)),
				   @colwidths));
	my $colgroup = "<colgroup>\n$colspecs</colgroup>\n";
	return qq($colgroup$rest);
    }

    sub thead = { # PROCESS
	my ($dom, $str) = @_;
	$str =~ s|(</?t)d|${1}h|g;
	return qq(<thead valign="bottom">\n$str</thead>\n);
    }

    sub tbody = { # PROCESS
	my ($dom, $str) = @_;
	return qq(<tbody valign="top">\n$str</tbody>\n);
    }

    sub row = { # PROCESS
	my ($dom, $str) = @_;
	my $attr = defined $dom->{row_attr} && $dom->{row_attr} ne '' ?
	    " $dom->{row_attr}" : '';
	my $dom_attr = GetAttr($dom);
	$attr .= $dom_attr if $dom_attr ne '';
	return qq(<tr$attr>$str</tr>\n);
    }

    sub entry = { # PROCESS
	my ($dom, $str) = @_;
	my $attr = $dom->{attr};
	my $eattr = $dom->{entry_attr} || '';
	# uncoverable branch false not:There are no pass-thru attributes
	%{$dom->{_html}{attr}} =
	    (map($_ eq 'morerows' ? ('rowspan'=>$attr->{$_}+1) :
		 $_ eq 'morecols' ? ('colspan'=>$attr->{$_}+1) :
		 $_ eq 'classes' ||
		 $_ eq 'align' && $attr->{$_} eq 'left'? () :
		 ($_=>$attr->{$_}), keys %$attr),
	     $eattr =~ /(\w+)(?:=(\S+))?/g,
	     $eattr =~ /(\w+)="(.*?)"/g);
	my $attrlist = GetAttr($dom);
	$str = '&nbsp;' if $str eq '';
	my $tag = $attr->{classes} && grep($_ eq 'stub', @{$attr->{classes}}) ?
	    "th" : "td";
	return qq(<$tag$attrlist>$str</$tag>\n);
    }

    sub citation_reference = { # PROCESS
	my ($dom, $str) = @_;
	my $hattr = $dom->{_html}{attr} = {};
	push @{$dom->{attr}{classes}}, 'citation-reference';
	my $ref = $hattr->{href} = "#$dom->{attr}{refid}";
	$hattr->{name} = $hattr->{id} = $dom->{attr}{ids}[0];
	my $target = &$TARGET_FRAME($ref);
	$hattr->{target} = $target if $target ne '';
	my $attr = GetAttr($dom);
	return qq(<a$attr>[$str]</a>);
    }

    sub image = { # PROCESS
	my ($dom, $str) = @_;

	my $attr = $dom->{attr};
	my $uri = $attr->{uri};
	if ($IMAGE_EXT_RE) {
	    $uri =~ s/($IMAGE_EXT_RE)$/$IMAGE_EXTS{$1}/o;
	}
	my $alt = defined $attr->{alt} ? $attr->{alt} : $uri;
	my $hattr = $dom->{_html}{attr} = {};
	@$hattr{qw(alt src)} = ($alt, $uri);
 	my @attr_out = qw(height width align usemap);
	foreach (@attr_out) {
	    $hattr->{$_} = $attr->{$_} if defined $attr->{$_};
	}
#	$hattr->{refid} = $dom->{attr}{ids} if $dom->{attr}{ids};
	my $attrlist = GetAttr($dom);
	my $img = qq(<img$attrlist />);
	return $img;
    }

    sub figure = { # PROCESS
	my ($dom, $str) = @_;
	# Copy the non-classes attributes to {_html}{attr}
	%{$dom->{_html}{attr}} = map($_ ne 'classes' ? ($_, $dom->{attr}{$_}) :
				     (), keys %{$dom->{attr}});
	push @{$dom->{attr}{classes}}, 'figure';
	my $attr = GetAttr($dom);
	return qq(<div$attr>\n$str</div>\n);
    }

    sub caption = { # PROCESS
	my ($dom, $str) = @_;
	chomp $str;
	my $parent = $dom->parent;
	return $parent->tag eq 'table' ? qq(<caption>$str</caption>\n) :
	    qq(<p class="caption">$str</p>\n);
    }

    sub legend = { # PROCESS
	my ($dom, $str) = @_;
	return qq(<div class="legend">\n$str</div>\n);
    }

    sub line_block = { # PROCESS
	my ($dom, $str) = @_;
	$dom->{attr}{classes} = [ 'line-block' ] unless $dom->{attr}{classes};
	my $attr = GetAttr($dom);
	return qq(<div$attr>\n$str</div>\n);
    }

    sub line = { # PROCESS
	my ($dom, $str) = @_;
	chomp $str;
	$str = "<br />" if $str eq '';
	return qq(<div class="line">$str</div>\n);;
    }

    sub parsed_literal = { # PROCESS
	my ($dom, $str) = @_;

	my $attr = $dom->{attr};
	$attr->{classes} ||= [];
	push @{$attr->{classes}}, 'parsed-literal';
	my $attrlist = GetAttr($dom);
	return qq(<pre$attrlist>$str</pre>\n);
    }

    sub system_message = { # PROCESS
	my ($dom, $str) = @_;

	my $parent = $dom->parent;
	my $attr = $dom->{attr};
	my $backlink = $attr->{backrefs} ?
	    '; <em>backrefs ' .
	    join(' ',map(qq(<a href="#$_">$_</a>), @{$attr->{backrefs}})) .
	    '</em>' : '';
	my $name = $attr->{ids} ? qq( name="$attr->{ids}[0]") : '';
	my $line = $attr->{line} ? qq(, line $attr->{line}) : '';
	my $id = $attr->{ids} ? qq( id="$attr->{ids}[0]") : '';
	return << "EOS" 
<div class="system-message"$id>
<p class="system-message-title">System Message: <a$name>$attr->{type}/$attr->{level}</a> (<tt class="docutils">$attr->{source}</tt>$line)$backlink</p>
$str</div>
EOS
	    if ($parent->{attr}{classes} && @{$parent->{attr}{classes}} &&
		$parent->{attr}{classes}[0] eq 'system-messages');
	return;
    }

    sub raw = { # PROCESS
	my ($dom) = @_;
	return unless $dom->{attr}{format} =~ /\bhtml\b/;
	my $s = $dom->first->{text};
	chomp $s;
	if ($dom->{attr}{head}) {
	    push @HEAD, "$s\n";
	    return;
	}
	return $s unless $dom->{attr}{classes};
	my $parent = $dom->parent;
	my $tag = $parent->tag =~ /section|document/ ? 'div' : 'span';
	my $attr = GetAttr($dom);
	return qq(<$tag$attr>$s</$tag>);
    }

    sub subtitle|label|decoration|colspec|substitution_(?:definition|reference) = { # PROCESS
	return;
    }

    sub document = { # PROCESS
	my ($dom, $str, $writer) = @_;
	my $doc = [[], []];

	# Handle the prolog
	my $enc = $writer->{opt}{e} || 'utf-8';
	$enc =~ s/(utf)(\d+)/$1-$2/;
	push @{$doc->[0]}, qq(<?xml version="1.0" encoding="$enc" ?>\n)
	    unless $html_prolog;
	push @{$doc->[0]}, $DOCTYPE;
	push (@{$doc->[0]}, qq(<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">\n));
	unshift (@{$doc->[1]}, qq(</html>\n));

	# Handle the header
	my $head = [["<head>\n"], ["</head>\n"]];
	push (@{$doc->[0]}, $head);
	push (@{$head->[0]}, 
	      qq(<meta http-equiv="Content-Type" content="text/html; charset=$enc" />\n));
	push (@{$head->[0]},
	      qq(<meta name="generator" content="$dom->{TOOL_ID}" />\n))
	    unless defined $writer->{opt}{D}{generator} &&
	    $writer->{opt}{D}{generator} eq 0;
	my $title = $dom->num_contents &&
	    $dom->first->tag eq 'title' ?
	    $dom->first->{_html}{str} : $dom->{attr}{title} || '';
	$title = SanitizeTitle($title);
	my $subtitle = $dom->num_contents > 1 &&
	    $dom->child(1)->tag eq 'subtitle' ?
	    $dom->child(1)->{_html}{str} : '';
	$subtitle = SanitizeTitle($subtitle);
	push (@{$head->[0]}, "<title>$title</title>\n") if $title ne '';
	push (@{$head->[0]},
	      map(ref($_) ? qq(<meta name="$_->[0]" content="$_->[1]" />\n) :
		  $_, @HEAD_INFO));
	my @embeds;
	if ($stylesheet =~ /^none$/i) {
	    # Find the default stylesheet
	    my $default = "Text/Restructured/default.css";
	    my ($dir) = grep -f "$_/$default", @INC;
	    push @embeds, "$dir/$default";
	    $stylesheet = 0;
	}
	elsif ($stylesheet !~ /^http:/ && $embed_stylesheet) {
	    push @embeds, $stylesheet =~ m!^file:(?://)?(.*)! ? $1 :
		$stylesheet;
	    $stylesheet = 0;
	}
	if ($stylesheet) {
	    push @{$head->[0]}, qq(<link rel="stylesheet" href="$stylesheet" type="text/css" />\n);
	}
	push @embeds, $stylesheet2 if $stylesheet2;
	foreach my $embed (@embeds) {
	    open SS, $embed or die "Cannot open stylesheet $embed";
	    my $ss_text = join '', <SS>;
	    push(@{$head->[0]},
		 sprintf(qq(<style type="text/css">\n%s</style>\n),
			 $ss_text));
	}
	push @{$head->[0]}, @HEAD if @HEAD;
	# Handle the body.
        my $battr = $body_attr ? " $body_attr" : '';
	my $body = $body_only ? [] : [["<body$battr>\n"], ["</body>\n"]];
	unshift @{$body->[1]}, $FOOTER if defined $FOOTER;
	push @{$doc->[0]}, $body;
	push @{$body->[0]}, $HEADER if defined $HEADER;
	push @{$body->[0]}, map(qq(<span id="$_"></span>),
				@{$dom->{attr}{ids}}
				[1 .. $#{$dom->{attr}{ids}}])
	    if $dom->{attr}{ids} && @{$dom->{attr}{ids}} > 1;
	push (@{$body->[0]},
	      qq(<div class="document") .
	      ($dom->{attr}{ids} ? qq( id="$dom->{attr}{ids}[0]") : "")
	      . qq(>\n));
	unshift (@{$body->[1]}, qq(</div>\n));
	push (@{$body->[0]}, qq(<h1 class="title">$title</h1>\n))
	    if $title ne '' && ! $writer->{opt}{D}{keep_title_section};
	my $id = $dom->num_contents > 1 &&
	    $dom->child(1)->{attr}{ids} ?
	    qq( id="${\$dom->child(1)->{attr}{ids}[0]}") : '';
	if ($subtitle ne '') {
	    my $stdom = $dom->child(1);
	    push @{$body->[0]}, map(qq(<span id="$_"></span>),
				    @{$stdom->{attr}{ids}}
				    [1 .. $#{$stdom->{attr}{ids}}])
		if @{$stdom->{attr}{ids}} > 1;
	    push (@{$body->[0]}, qq(<h2 class="subtitle"$id>$subtitle</h2>\n))
	    }

	# Next go through all the contents
	my $content;
	foreach $content ($dom->contents) {
	    next if $content->tag =~ /title$/;
	    push (@{$body->[0]}, $content->{val});
	}

	my @list = $body_only ? Flatten($body) : Flatten($doc);
	return join '',@list;

	# This subroutine takes an array of items which may
	# contain array references and flattens them into the
	# a new array.
	sub Flatten {
	    my @answer;
	    foreach (@_) {
		next unless defined $_;
		if (ref($_) eq 'ARRAY') {
		    push(@answer, Flatten(@$_));
		}
		else {
		    push(@answer, $_);
		}
	    }
	    return @answer;
	}
    }

    sub docinfo = { # PROCESS
	my ($dom, $str) = @_;
	$str =~ s/field-name/docinfo-name/g;
	return << "EOS" ;
<table class="docinfo" frame="void" rules="none">
<col class="docinfo-name" />
<col class="docinfo-content" />
<tbody valign="top">
$str</tbody>
</table>
EOS
    }

    sub address = { # PROCESS
	my ($dom, $str) = @_;
	return << "EOS" ;
<tr><th class="docinfo-name">Address:</th>
<td><pre class="address">
$str</pre>
</td></tr>
EOS
    }

    sub author|contact|organization|date|status|revision|version|copyright = { # PROCESS
	my ($dom, $str) = @_;
	my $label = $dom->tag;
	substr($label,0,1) =~ tr/[a-z]/[A-Z]/;
	chomp $str;
	return qq(<tr><th class="docinfo-name">$label:</th>\n<td>$str</td></tr>\n);
    }

    sub header = { # PROCESS
	my ($dom, $str) = @_;

	$HEADER =
	    qq(<div class="header">\n$str\n<hr class="header"/>\n</div>\n);
	return;
    }

    sub footer = { # PROCESS
	my ($dom, $str) = @_;

	$FOOTER = 
	    qq(<div class="footer">\n<hr class="footer" />\n$str\n</div>\n);
	return;
    }

    sub div = { # PROCESS
	my ($dom, $str) = @_;
	my $nl = $dom->num_contents > 1 ? "\n" : '';
	return qq(<div class="@{$dom->{attr}{classes}}">$nl$str</div>\n);
    }

    sub title_reference = { # PROCESS
	my ($dom, $str) = @_;

	return qq(<cite>$str</cite>);
    }

    sub inline = { # PROCESS
	my ($dom, $str) = @_;

	my $tag = 'span';
	my $attr = GetAttr($dom);
	return qq(<$tag$attr>$str</$tag>);
    }

    sub .* = { # PROCESS
	my ($dom, $str) = @_;
	if ($USED_DEFAULT{$dom->tag}) {
	    print STDERR
		"Warning: Used default handler for type ${\$dom->tag}\n";
	    $USED_DEFAULT{$dom->tag} = 0;
	}
	return $dom->{val};
    }
}
